home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / UTILS / DBVIEWQ.ZIP / OBJECTSL.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-07-17  |  18.5 KB  |  530 lines
  1. VERSION 4.00
  2. Begin VB.Form frmObjects 
  3.    Caption         =   "Object Selection"
  4.    ClientHeight    =   5775
  5.    ClientLeft      =   1170
  6.    ClientTop       =   1140
  7.    ClientWidth     =   6165
  8.    Height          =   6180
  9.    HelpContextID   =   250
  10.    Left            =   1110
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   5775
  13.    ScaleWidth      =   6165
  14.    Top             =   795
  15.    Width           =   6285
  16.    Begin VB.ListBox lstQueries 
  17.       Height          =   2760
  18.       HelpContextID   =   420
  19.       Left            =   3240
  20.       MultiSelect     =   2  'Extended
  21.       TabIndex        =   3
  22.       Tag             =   "List of Available Queries"
  23.       Top             =   1080
  24.       Width           =   2775
  25.    End
  26.    Begin VB.CheckBox chkRelations 
  27.       Caption         =   "Print Table Relations"
  28.       Height          =   255
  29.       HelpContextID   =   440
  30.       Left            =   3720
  31.       TabIndex        =   11
  32.       Tag             =   "Print Table Relations"
  33.       Top             =   240
  34.       Width           =   1935
  35.    End
  36.    Begin VB.CheckBox chkGeneral 
  37.       Caption         =   "Print General Database Information"
  38.       Height          =   255
  39.       HelpContextID   =   460
  40.       Left            =   360
  41.       TabIndex        =   10
  42.       Tag             =   "Print General Database Information"
  43.       Top             =   240
  44.       Width           =   2895
  45.    End
  46.    Begin VB.CommandButton cmdAllTables 
  47.       Caption         =   "Deselect All Tables"
  48.       Height          =   375
  49.       HelpContextID   =   480
  50.       Index           =   1
  51.       Left            =   360
  52.       TabIndex        =   9
  53.       Tag             =   "Deselect All Tables"
  54.       Top             =   4440
  55.       Width           =   2175
  56.    End
  57.    Begin VB.CommandButton cmdAllQueries 
  58.       Caption         =   "Deselect All Queries"
  59.       Height          =   375
  60.       HelpContextID   =   500
  61.       Index           =   1
  62.       Left            =   3480
  63.       TabIndex        =   8
  64.       Tag             =   "Deselect All Queries"
  65.       Top             =   4440
  66.       Width           =   2295
  67.    End
  68.    Begin VB.CommandButton cmdExit 
  69.       Cancel          =   -1  'True
  70.       Caption         =   "Exit"
  71.       Height          =   375
  72.       HelpContextID   =   520
  73.       Left            =   3480
  74.       TabIndex        =   7
  75.       Tag             =   "Return to the Main Menu"
  76.       Top             =   5160
  77.       Width           =   1935
  78.    End
  79.    Begin VB.CommandButton cmdRun 
  80.       Caption         =   "Run Analysis"
  81.       Height          =   375
  82.       HelpContextID   =   540
  83.       Left            =   600
  84.       TabIndex        =   6
  85.       Tag             =   "Print the selected database information"
  86.       Top             =   5160
  87.       Width           =   1935
  88.    End
  89.    Begin VB.CommandButton cmdAllQueries 
  90.       Caption         =   "Select All Queries"
  91.       Height          =   375
  92.       HelpContextID   =   560
  93.       Index           =   0
  94.       Left            =   3480
  95.       TabIndex        =   5
  96.       Tag             =   "Select All Queries"
  97.       Top             =   3960
  98.       Width           =   2295
  99.    End
  100.    Begin VB.CommandButton cmdAllTables 
  101.       Caption         =   "Select All Tables"
  102.       Height          =   375
  103.       HelpContextID   =   580
  104.       Index           =   0
  105.       Left            =   360
  106.       TabIndex        =   4
  107.       Tag             =   "Select All Tables"
  108.       Top             =   3960
  109.       Width           =   2175
  110.    End
  111.    Begin VB.ListBox lstTables 
  112.       Height          =   2760
  113.       HelpContextID   =   600
  114.       Left            =   120
  115.       MultiSelect     =   2  'Extended
  116.       TabIndex        =   2
  117.       Tag             =   "List of Available Tables"
  118.       Top             =   1080
  119.       Width           =   2655
  120.    End
  121.    Begin VB.Line Line3 
  122.       X1              =   3000
  123.       X2              =   3000
  124.       Y1              =   720
  125.       Y2              =   4920
  126.    End
  127.    Begin VB.Line Line2 
  128.       X1              =   120
  129.       X2              =   6000
  130.       Y1              =   4920
  131.       Y2              =   4920
  132.    End
  133.    Begin VB.Line Line1 
  134.       X1              =   120
  135.       X2              =   6000
  136.       Y1              =   720
  137.       Y2              =   720
  138.    End
  139.    Begin VB.Label Label2 
  140.       Caption         =   "QueryDefs to Analyze:"
  141.       Height          =   255
  142.       Left            =   3960
  143.       TabIndex        =   1
  144.       Top             =   840
  145.       Width           =   1695
  146.    End
  147.    Begin VB.Label Label1 
  148.       Caption         =   "Tables to Analyze:"
  149.       Height          =   255
  150.       Left            =   600
  151.       TabIndex        =   0
  152.       Top             =   840
  153.       Width           =   1455
  154.    End
  155. Attribute VB_Name = "frmObjects"
  156. Attribute VB_Creatable = False
  157. Attribute VB_Exposed = False
  158. Dim Headr1 As String, Headr2 As String, ipage As Integer
  159. Sub Header(action As Integer)
  160. If ipage > 0 Then
  161.     'Print the page number centered at the bottom of the page
  162.     hdrstr = "Page " & Str(ipage)
  163.     hdrwid = Printer.TextWidth(hdrstr)
  164.     hdrhgt = Printer.TextHeight(hdrstr)
  165.     Printer.CurrentY = Printer.Height - 2 * hdrhgt - 720
  166.     Printer.CurrentX = (Printer.Width - hdrwid) / 2 - 360
  167.     Printer.Print hdrstr
  168.     Printer.NewPage
  169. End If
  170. If action > 0 Then Exit Sub
  171. 'Print database name centered at the top of the page
  172. Printer.Font.Size = 14
  173. Printer.Font.Bold = True
  174. hdrwid = Printer.TextWidth(Headr1)
  175. Printer.CurrentY = 0
  176. Printer.CurrentX = (Printer.Width - hdrwid) / 2 - 360
  177. Printer.Print Headr1
  178. 'Print the version number centered, below the name
  179. Printer.Font.Size = 12
  180. Printer.Font.Bold = False
  181. hdrwid = Printer.TextWidth(Headr2)
  182. Printer.CurrentX = (Printer.Width - hdrwid) / 2 - 360
  183. Printer.Print Headr2
  184. 'Print the report date
  185. Printer.Print
  186. Printer.Font.Size = 10
  187. Printer.Print "Report Date: "; Date
  188. ipage = ipage + 1
  189. End Sub
  190. Private Sub cmdAllQueries_Click(Index As Integer)
  191. Dim numqry As Integer
  192. numqry = lstQueries.ListCount
  193. If numqry > 0 Then
  194.     If Index = 0 Then
  195.         For I = 0 To numqry - 1
  196.             lstQueries.Selected(I) = True
  197.         Next I
  198.     Else
  199.         For I = 0 To numqry - 1
  200.             lstQueries.Selected(I) = False
  201.         Next I
  202.     End If
  203. End If
  204. End Sub
  205. Private Sub cmdAllTables_Click(Index As Integer)
  206. Dim numtbl As Integer
  207. numtbl = lstTables.ListCount
  208. If numtbl > 0 Then
  209.     If Index = 0 Then
  210.         For I = 0 To numtbl - 1
  211.             lstTables.Selected(I) = True
  212.         Next I
  213.     Else
  214.         For I = 0 To numtbl - 1
  215.             lstTables.Selected(I) = False
  216.         Next I
  217.     End If
  218. End If
  219. End Sub
  220. Private Sub cmdExit_Click()
  221. Unload Me
  222. End Sub
  223. Private Sub cmdRun_Click()
  224. Dim numtbl As Integer, I As Integer, tblName As String, Fld As Field
  225. Dim fltype As String, dbRel As Relation, relAttr As Long, SQLstr As String
  226. Dim PrntGen As Integer, PrntRel As Integer, tblIdx As Index
  227. ReDim flAttr(1 To 4) As Integer
  228. Screen.MousePointer = 11
  229. 'Get database options information
  230. PrntGen = False
  231. PrntRel = False
  232. If chkGeneral.VALUE = 1 Then PrntGen = True
  233. If chkRelations.VALUE = 1 Then PrntRel = True
  234. 'Set up page header
  235. Headr1 = "Database Name: " & OldDb.Name
  236. Headr2 = "Jet Version Number: " & OldDb.Version
  237. ipage = 0
  238. 'Print database information if desired
  239. If PrntGen Then
  240. End If
  241. 'Print table relations if desired
  242. If PrntRel Then
  243.     Call Header(0)
  244.     For Each dbRel In OldDb.Relations
  245.         Printer.Print " "
  246.         Printer.Print " "
  247.         Printer.Print "Relation Name: "; dbRel.Name
  248.         Printer.Print Tab(5); "Primary Table: "; dbRel.TABLE
  249.         Printer.Print Tab(5); "Related Table: "; dbRel.ForeignTable
  250.         relAttr = dbRel.Attributes
  251.         If relAttr >= dbRelationRight Then
  252.             Printer.Print Tab(5); "Relation is a right join"
  253.             relAttr = relAttr - dbRelationRight
  254.         End If
  255.         If relAttr >= dbRelationLeft Then
  256.             Printer.Print Tab(5); "Relation is a left join"
  257.             relAttr = relAttr - dbRelationLeft
  258.         End If
  259.         If relAttr >= dbRelationDeleteCascade Then
  260.             Printer.Print Tab(5); "Relation uses cascaded deletions"
  261.             relAttr = relAttr - dbRelationDeleteCascade
  262.         End If
  263.         If relAttr >= dbRelationUpdateCascade Then
  264.             Printer.Print Tab(5); "Relation uses cascaded updates"
  265.             relAttr = relAttr - dbRelationUpdateCascade
  266.         End If
  267.         If relAttr >= dbRelationDontEnforce Then
  268.             Printer.Print Tab(5); "Referential Integrity is not enforced"
  269.             relAttr = relAttr - dbRelationDontEnforce
  270.         End If
  271.         If relAttr = dbRelationUnique Then
  272.             Printer.Print Tab(5); "Relation is a one-to-one relationship"
  273.         End If
  274.         'Print relationship fields
  275.         Printer.Print " "
  276.         Printer.Print Tab(5); "Primary field"; Tab(25); "Related Field"
  277.         For Each Fld In dbRel.Fields
  278.             Printer.Print Tab(5); Fld.Name; Tab(25); Fld.ForeignName
  279.         Next Fld
  280.     Next dbRel
  281. End If
  282. numtbl = lstTables.ListCount
  283. 'Print table information for each selected table.
  284. If numtbl > 0 Then
  285.     'Check each table to see if it is selected.
  286.     For I = 0 To numtbl - 1
  287.         If lstTables.Selected(I) Then
  288.             Call Header(0)
  289.             tblName = lstTables.List(I)
  290.             Set Tbl = OldDb.TableDefs(tblName)
  291.             'Print table information
  292.             Printer.Print
  293.             Printer.Print
  294.             Printer.Font.Size = 12
  295.             Printer.Font.Bold = True
  296.             Printer.Print "Table Name: "; tblName
  297.             Printer.Font.Size = 10
  298.             Printer.Font.Bold = False
  299.             Printer.Print
  300.             Printer.Print
  301.             Printer.Print "Created on: "; Tbl.DateCreated
  302.             Printer.Print "Last updated on: "; Tbl.LastUpdated
  303.             Printer.Print "Current number of records: "; Tbl.RecordCount
  304.             If Tbl.Updatable Then
  305.                 Printer.Print "Table may be updated"
  306.             Else
  307.                 Printer.Print "Table may not be updated"
  308.             End If
  309.             flvalid = Tbl.ValidationRule
  310.             If Len(Trim(flvalid)) > 0 Then
  311.                 Printer.Print "    Table Validation:"
  312.                 Printer.Print "    Rule: "; flvalid
  313.                 Printer.Print "    Error Text: "; Fld.ValidationText
  314.             End If
  315.             'Print fields header
  316.             Printer.Print
  317.             Printer.Print
  318.             Printer.Font.Bold = True
  319.             Printer.Print "Fields"
  320.             Printer.Print
  321.             Printer.Font.Bold = False
  322.             Printer.Font.Underline = True
  323.             Printer.Print "Name"; Tab(15); "Type"; Tab(30); "Size"; Tab(40); _
  324.                 "Required"; Tab(50); "0 Len OK"; Tab(60); "Updatable"
  325.             Printer.Font.Underline = False
  326.             Printer.Print
  327.             'Print information for each field
  328.             For Each Fld In Tbl.Fields
  329.                 'Set initial values
  330.                 flreq = "No"
  331.                 flZero = "No"
  332.                 flUpdt = "No"
  333.                 'Get field attributes
  334.                 For J = 1 To 4
  335.                     flAttr(J) = False
  336.                 Next J
  337.                 atrval = Fld.Attributes
  338.                 If atrval >= 32 Then
  339.                     flAttr(4) = True
  340.                     atrval = atrval - 32
  341.                 End If
  342.                 If atrval >= 16 Then
  343.                     flAttr(3) = True
  344.                     atrval = atrval - 16
  345.                 End If
  346.                 If atrval >= 2 Then
  347.                     flAttr(2) = True
  348.                     atrval = atrval - 2
  349.                 End If
  350.                 If atrval = 1 Then flAttr(1) = True
  351.                 'Determine field type and size
  352.                 flsize = "N/A"
  353.                 Select Case Fld.Type
  354.                     Case 1
  355.                         fltype = "Boolean"
  356.                     Case 2
  357.                         fltype = "Byte"
  358.                     Case 3
  359.                         fltype = "Integer"
  360.                     Case 4
  361.                         fltype = "Long"
  362.                         If flAttr(3) Then fltype = "Counter"
  363.                     Case 5
  364.                         fltype = "Currency"
  365.                     Case 6
  366.                         fltype = "Single"
  367.                     Case 7
  368.                         fltype = "Double"
  369.                     Case 8
  370.                         fltype = "Date"
  371.                     Case 10
  372.                         fltype = "Text"
  373.                         flsize = Str(Fld.Size)
  374.                     Case 11
  375.                         fltype = "Binary"
  376.                     Case 12
  377.                         fltype = "Memo"
  378.                 End Select
  379.                 'Set values of required, zero length, and updatable
  380.                 If Fld.Required Then flreq = "Yes"
  381.                 If Fld.AllowZeroLength Then flZero = "Yes"
  382.                 If Fld.DataUpdatable Then flUpdt = "Yes"
  383.                 Printer.Print Fld.Name; Tab(15); fltype; Tab(30); flsize; _
  384.                     Tab(40); flreq; Tab(50); flZero; Tab(60); flUpdt
  385.                 'Print validation information
  386.                 flvalid = Fld.ValidationRule
  387.                 If Len(Trim(flvalid)) > 0 Then
  388.                     Printer.Print "    Validation:"
  389.                     Printer.Print "    Rule: "; flvalid
  390.                     Printer.Print "    Error Text: "; Fld.ValidationText
  391.                     If Fld.ValidateOnSet Then
  392.                         Printer.Print "    Validate when field value is set."
  393.                     Else
  394.                         Printer.Print "    Validate when field is updated."
  395.                     End If
  396.                 End If
  397.             Next Fld
  398.             'Print index information
  399.             Printer.Print
  400.             Printer.Print
  401.             Printer.Font.Bold = True
  402.             Printer.Print "Indexes"
  403.             Printer.Font.Bold = False
  404.             For Each tblIdx In Tbl.Indexes
  405.                 'Print index header
  406.                 Printer.Print
  407.                 Printer.Print "Index Name: "; tblIdx.Name
  408.                 If tblIdx.UNIQUE Then
  409.                     Printer.Print Tab(5); "Unique key values are required"
  410.                 End If
  411.                 If tblIdx.PRIMARY Then
  412.                     Printer.Print Tab(5); "This is a primary index"
  413.                 End If
  414.                 If tblIdx.Required Then
  415.                     Printer.Print Tab(5); "Non-null key values are required"
  416.                 End If
  417.                 If tblIdx.IgnoreNulls Then
  418.                     Printer.Print Tab(5); "Null key values are ignored"
  419.                 End If
  420.                 Printer.Print
  421.                 Printer.Print Tab(5); "Fields"
  422.                 Printer.Print
  423.                 Printer.Font.Underline = True
  424.                 Printer.Print Tab(5); "Name"; Tab(20); "Order"
  425.                 Printer.Font.Underline = False
  426.                 Printer.Print
  427.                 'Print information for each field
  428.                 For Each Fld In tblIdx.Fields
  429.                     If Fld.Attributes = 1 Then
  430.                         florder = "Descending"
  431.                     Else
  432.                         florder = "Ascending"
  433.                     End If
  434.                     Printer.Print Tab(5); Fld.Name; Tab(20); florder
  435.                 Next Fld
  436.             Next tblIdx
  437.         End If
  438.     Next I
  439. End If
  440. numtbl = lstQueries.ListCount
  441. 'Print information for each selected query
  442. If numtbl > 0 Then
  443.     For I = 0 To numtbl - 1
  444.         If lstQueries.Selected(I) Then
  445.             Call Header(0)
  446.             qryName = lstQueries.List(I)
  447.             Set Qry = OldDb.QueryDefs(qryName)
  448.             'Print query information
  449.             Printer.Print
  450.             Printer.Print
  451.             Printer.Font.Size = 12
  452.             Printer.Font.Bold = True
  453.             Printer.Print "Query Name: "; qryName
  454.             Printer.Font.Size = 10
  455.             Printer.Font.Bold = False
  456.             Printer.Print
  457.             Printer.Print
  458.             Printer.Print "Created on: "; Qry.DateCreated
  459.             Printer.Print "Last updated on: "; Qry.LastUpdated
  460.             If Qry.Updatable Then
  461.                 Printer.Print "Query definition may be updated"
  462.             Else
  463.                 Printer.Print "Query definition may not be updated"
  464.             End If
  465.             'Print query type
  466.             Select Case Qry.Type
  467.                 Case dbQSelect
  468.                     Printer.Print "This is a SELECT query"
  469.                 Case dbQAction
  470.                     Printer.Print "This is an Action query"
  471.                 Case dbQCrosstab
  472.                     Printer.Print "This is a Cross-tab query"
  473.                 Case dbQDelete
  474.                     Printer.Print "This is a DELETE query"
  475.                 Case dbQUpdate
  476.                     Printer.Print "This is an UPDATE query"
  477.                 Case dbQAppend
  478.                     Printer.Print "This is an APPEND query"
  479.                 Case dbQMakeTable
  480.                     Printer.Print "This is a Table creation query"
  481.                 Case dbQDDL
  482.                     Printer.Print "This is a Data Definition Language query"
  483.                 Case dbQSQLPassThrough
  484.                     Printer.Print "This is an SQL pass-through query"
  485.             End Select
  486.             'Print the SQL statement
  487.             Printer.Print
  488.             Printer.Font.Bold = True
  489.             Printer.Print "SQL Statement"
  490.             Printer.Font.Bold = False
  491.             SQLstr = Qry.SQL
  492.             Call MmoPrnt(SQLstr)
  493. '            Printer.Print SQLstr
  494.             'Print the field information for the query
  495.             'Print fields header
  496.             Printer.Print
  497.             Printer.Print
  498.             Printer.Font.Bold = True
  499.             Printer.Print "Fields"
  500.             Printer.Print
  501.             Printer.Font.Bold = False
  502.             Printer.Font.Underline = True
  503.             Printer.Print "Name"; Tab(25); "Source Field"; Tab(40); "Source Table"
  504.             Printer.Font.Underline = False
  505.             Printer.Print
  506.             'Print information for each field
  507.             For Each Fld In Qry.Fields
  508.                 Printer.Print Fld.Name; Tab(25); Fld.SourceField; Tab(40); Fld.SourceTable
  509.             Next Fld
  510.         End If
  511.     Next I
  512. End If
  513. Call Header(1)
  514. Printer.EndDoc
  515. Screen.MousePointer = 0
  516. End Sub
  517. Private Sub Form_Load()
  518. Dim Tbl As TableDef, Qry As QueryDef
  519. 'Load table list
  520. For Each Tbl In OldDb.TableDefs
  521.     If Left(Tbl.Name, 4) <> "MSys" Then
  522.         lstTables.AddItem Tbl.Name
  523.     End If
  524. Next Tbl
  525. 'Load query list
  526. For Each Qry In OldDb.QueryDefs
  527.     lstQueries.AddItem Qry.Name
  528. Next Qry
  529. End Sub
  530.